home *** CD-ROM | disk | FTP | other *** search
/ PsL Monthly 1993 December / PSL Monthly Shareware CD-ROM (December 1993).iso / prgmming / win / pascal / toolbox.exe / TOOLBOX.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-25  |  10.7 KB  |  274 lines
  1. Unit ToolBox;
  2. {**********************************************************}
  3. { ToolBox.pas by David Radecki (CIS: 72330,2255)           }
  4. {                                                          }
  5. {  This unit builds a toolbox similar to that found in     }
  6. {  Borland's Resource Workshop Dialog Editor.  The code    }
  7. {  is my own, but it was greatly influenced by several     }
  8. {  examples I found in the Borland ProgA library, in       }
  9. {  addition to an article in Windows Tech Journal          }
  10. {  (Premiere Issue) by Richard A. Levaro "A Perfect Fit".  }
  11. {  It was a great help.  This unit is not exactly a clinic }
  12. {  in TPW or object-oriented coding, more like a first     }
  13. {  stab at custom control development.  I would appreciate }
  14. {  any comments (good or bad), constructive criticism is   }
  15. {  welcomed.  This code is hereby donated to the Public    }
  16. {  Domain.                                                 }
  17. {                                                          }
  18. {  The idea behind this unit is quite simple.  Toolbox     }
  19. {  builds a child window, and paints it with the bitmaps   }
  20. {  supplied to it by the Toolbox Init constructor.  The    }
  21. {  bitmaps and all ancillary information (bitmap sizes,    }
  22. {  position inside the window, and button state) is stored }
  23. {  in a collection.  The only parameters needed for the    }
  24. {  collection initialization are the two bitmap names for  }
  25. {  the up and down position respectively.  The collection  }
  26. {  initialization call needs to contain at least the       }
  27. {  number of Insert statements made for the button         }
  28. {  collection as shown below:                              }
  29. {                                                          }
  30. {  constructor TToolDemo.Init(AParent:PWindowsObject;      }
  31. {                             ATitle:PChar);               }
  32. {  begin                                                   }
  33. {     collection := New(PCollection,Init(# of Buttons,0)); }
  34. {     with collection^ do                                  }
  35. {     begin                                                }
  36. {        Insert(New(PToolButton,Init(Button1a,Button1b))); }
  37. {        Number of insert stmts match number of buttons    }
  38. {        declared in init statement                        }
  39. {     end;                                                 }
  40. {     TToolBox.Init(AParent,ATitle,Rows,Cols,DefaultButton,}
  41. {                   X-Position,Y-Position);                }
  42. {  end;                                                    }
  43. {                                                          }
  44. {  Remember that I have supplied no button shading, that   }
  45. {  is up to the responsible button designer.               }
  46. {                                                          }
  47. {  In the window Init procedure, make sure to include the  }
  48. {  TToolBox.Init call.  The parameters include the window's}
  49. {  parent pointer, the ToolBox's title, the number of      }
  50. {  button rows, the number of button columns, the default  }
  51. {  depressed button, and the x and y position within the   }
  52. {  parent window.                                          }
  53. {                                                          }
  54. {  The implementation of the button selection is simple.   }
  55. {  As shown in the demo program the ButtonHit procedure    }
  56. {  is called through the tb_buttonhit message.  The        }
  57. {  DepressedButton could be "cased" off of to call the     }
  58. {  desired procedure.                                      }
  59. {                                                          }
  60. {  Hope you enjoy this unit.                               }
  61. {                                                          }
  62. {**********************************************************}
  63.  
  64. interface
  65.  
  66. uses WObjects, WinTypes, WinProcs, Strings;
  67.  
  68. const
  69. Black_Border   = 2;
  70. Gray_Border    = 5;
  71.  
  72. Up             = 0;
  73. Down           = 1;
  74.  
  75. tb_buttonhit   = wm_User + 500;
  76.  
  77. type
  78.  
  79.    PToolButton = ^TToolButton;
  80.    TToolButton = object(TCollection)
  81.       ButtonHandle        : array [Up..Down] of hBitmap;
  82.       ButtonName          : array [Up..Down] of PChar;
  83.       ButtonRec           : TBitmap;
  84.       ButtonSpec          : TRect;
  85.       ButtonState         : Integer;
  86.       constructor Init(UpButtonName, DownButtonName : PChar);
  87.       destructor Done; virtual;
  88.    end;
  89.  
  90.    PToolBox = ^TToolBox;
  91.    TToolBox = object(TWindow)
  92.       DepressedButton,
  93.       MaxBottom,
  94.       MaxRight        : Integer;
  95.       ToolCollection  : PCollection;
  96.       MemDC           : hDC;
  97.       SysMenuH        : hMenu;
  98.       constructor Init(AParent: PWindowsObject; ATitle: PChar;
  99.                        RowButtonDim, ColButtonDim, DefaultDepress,
  100.                        XPosition,YPosition : Integer);
  101.       procedure   Paint(PaintDC : hDC; var PaintInfo : TPaintStruct); virtual;
  102.       procedure   WMLButtonDown (var Msg : TMessage); virtual wm_First + wm_LButtonDown;
  103.       procedure   SetupWindow; virtual;
  104.    end;
  105.  
  106. {************************************************************************}
  107. implementation
  108.  
  109. constructor TToolButton.Init(UpButtonName, DownButtonName : PChar);
  110. begin
  111.    ButtonName[Up] := StrNew(UpButtonName);
  112.    ButtonHandle[Up] := LoadBitmap(hInstance,ButtonName[Up]);
  113.    ButtonName[Down] := StrNew(DownButtonName);
  114.    ButtonHandle[Down] := LoadBitmap(hInstance,ButtonName[Down]);
  115.    ButtonState := Up;
  116.    GetObject(ButtonHandle[Up],Sizeof(TBitmap),@ButtonRec);
  117. end;
  118.  
  119. destructor TToolButton.Done;
  120. begin
  121.    StrDispose(ButtonName[Up]);
  122.    DeleteObject(ButtonHandle[Up]);
  123.    StrDispose(ButtonName[Down]);
  124.    DeleteObject(ButtonHandle[Down]);
  125. end;
  126.  
  127. {************************************************************************}
  128. constructor TToolBox.Init(AParent: PWindowsObject; ATitle: PChar;
  129.                  RowButtonDim, ColButtonDim, DefaultDepress,
  130.                  XPosition,YPosition : Integer);
  131. var
  132.    DisplayRow,
  133.    DisplayCol,
  134.    BitmapNum,
  135.    ButtonIndex  : Integer;
  136.  
  137.    procedure SetupButtonSpecs(SingleButton : PToolButton); far;
  138.    begin
  139.       BitmapNum := ToolCollection^.IndexOf(SingleButton);
  140.       DisplayRow := BitmapNum div ColButtonDim;
  141.       DisplayCol := BitmapNum mod ColButtonDim;
  142.       with SingleButton^ do
  143.       begin
  144.          ButtonSpec.Top := Gray_Border + Black_Border + (DisplayRow * Black_Border) +
  145.                            (DisplayRow * ButtonRec.BMHeight);
  146.          ButtonSpec.Left := Gray_Border + Black_Border + (DisplayCol * Black_Border) +
  147.                            (DisplayCol * ButtonRec.BMWidth);
  148.          ButtonSpec.Bottom := ButtonRec.BMHeight + ButtonSpec.Top;
  149.          ButtonSpec.Right := ButtonRec.BMWidth + ButtonSpec.Left;
  150.          if ButtonIndex = (DefaultDepress - 1)
  151.          then begin
  152.             ButtonState := Down;
  153.             DepressedButton := ButtonIndex;
  154.          end;
  155.          if BitmapNum = 0
  156.          then begin
  157.             MaxBottom := ButtonSpec.Bottom;
  158.             MaxRight := ButtonSpec.Right;
  159.          end
  160.          else begin
  161.             if ButtonSpec.Bottom > MaxBottom
  162.             then MaxBottom := ButtonSpec.Bottom;
  163.             if ButtonSpec.Right > MaxRight
  164.             then MaxRight := ButtonSpec.Right;
  165.          end;
  166.       end;
  167.       ToolCollection^.AtPut(ButtonIndex,SingleButton);
  168.       Inc(ButtonIndex);
  169.    end;
  170.  
  171. begin
  172.    TWindow.Init(AParent, ATitle);
  173.    SetFlags(wb_MDIChild,False);
  174.    ButtonIndex := 0;
  175.    DepressedButton := -1;
  176.    ToolCollection^.ForEach(@SetupButtonSpecs);
  177.    with Attr do
  178.    begin
  179.       Style := ws_Child or ws_Visible or ws_Overlapped or ws_ClipSiblings or ws_Caption
  180.                or ws_SysMenu and not ws_MaximizeBox and not ws_MinimizeBox;
  181.       W := MaxRight + (GetSystemMetrics(sm_CXBorder) * 2) +
  182.            Gray_Border + Black_Border;
  183.       H := MaxBottom + GetSystemMetrics(sm_CYBorder) +
  184.            GetSystemMetrics(sm_CYCaption) + Gray_Border + Black_Border;
  185.       X := XPosition;
  186.       Y := YPosition;
  187.    end;
  188. end;
  189.  
  190. procedure TToolBox.SetupWindow;
  191. begin
  192.    SysMenuH := GetSystemMenu(HWindow,false);
  193.    DeleteMenu(SysMenuH,8,mf_ByPosition);
  194.    DeleteMenu(SysMenuH,7,mf_ByPosition);
  195.    DeleteMenu(SysMenuH,6,mf_ByPosition);
  196.    DeleteMenu(SysMenuH,5,mf_ByPosition);
  197.    DeleteMenu(SysMenuH,4,mf_ByPosition);
  198.    DeleteMenu(SysMenuH,3,mf_ByPosition);
  199.    DeleteMenu(SysMenuH,2,mf_ByPosition);
  200.    DeleteMenu(SysMenuH,0,mf_ByPosition);
  201. end;
  202.  
  203. procedure TToolBox.Paint(PaintDC : hDC; var PaintInfo : TPaintStruct);
  204. var
  205.    hdcMem         : hDC;
  206.    hToolBarBitmap : hBitmap;
  207.    ToolBoxRect    : TRect;
  208.  
  209.    procedure DisplayButtons(SingleButton : PToolButton); far;
  210.    begin
  211.       SelectObject(MemDC,SingleButton^.ButtonHandle[SingleButton^.ButtonState]);
  212.       BitBlt(hdcMem,SingleButton^.ButtonSpec.Left,SingleButton^.ButtonSpec.Top,
  213.              SingleButton^.ButtonRec.BMWidth,SingleButton^.ButtonRec.BMHeight,
  214.              MemDC,0,0,SrcCopy);
  215.    end;
  216.  
  217. begin
  218.    TWindow.Paint(PaintDC, PaintInfo);
  219.    GetClientRect(HWindow, ToolBoxRect);
  220.    hdcMem := CreateCompatibleDC(PaintDC);
  221.    hToolBarBitmap := CreateCompatibleBitmap(PaintDC,ToolBoxRect.Right,ToolBoxRect.Bottom);
  222.    SelectObject(hdcMem,hToolBarBitmap);
  223.    SetMapMode(hdcMem,GetMapMode(PaintDC));
  224.    FillRect(hdcMem,ToolBoxRect,GetStockObject(ltgray_brush));
  225.    InflateRect(ToolBoxRect,-Gray_Border,-Gray_Border);
  226.    FillRect(hdcMem,ToolBoxRect,GetStockObject(black_brush));
  227.    InflateRect(ToolBoxRect,Gray_Border,Gray_Border);
  228.    MemDC := CreateCompatibleDC(PaintDC);
  229.    ToolCollection^.ForEach(@DisplayButtons);
  230.    BitBlt(PaintDC,0,0,ToolBoxRect.Right,ToolBoxRect.Bottom,hdcMem,0,0,SrcCopy);
  231.    DeleteDC(MemDC);
  232.    DeleteDC(hdcMem);
  233.    DeleteObject(hToolBarBitmap);
  234. end;
  235.  
  236. procedure TToolBox.WMLButtonDown (var Msg : TMessage);
  237. var
  238.    HotPoint : TPoint;
  239.    ButtonCheck : PToolButton;
  240.    ButtonCount : Integer;
  241.  
  242.    function ClickInButton(SingleButton : PToolButton) : Boolean; far;
  243.    begin
  244.       ClickInButton := PtInRect(SingleButton^.ButtonSpec, HotPoint) <> False;
  245.       Inc(ButtonCount);
  246.    end;
  247.  
  248. begin
  249.    ButtonCount := -1;
  250.    HotPoint.X := Msg.LParamLo;
  251.    HotPoint.Y := Msg.LParamHi;
  252.    ButtonCheck := ToolCollection^.FirstThat(@ClickInButton);
  253.    if ButtonCheck <> nil
  254.    then begin
  255.       if ButtonCount <> DepressedButton
  256.       then begin
  257.          ButtonCheck^.ButtonState := Down;
  258.          ToolCollection^.AtPut(ButtonCount,ButtonCheck);
  259.          if DepressedButton <> -1
  260.          then begin
  261.             ButtonCheck := ToolCollection^.At(DepressedButton);
  262.             ButtonCheck^.ButtonState := Up;
  263.             ToolCollection^.AtPut(DepressedButton,ButtonCheck);
  264.          end;
  265.          DepressedButton := ButtonCount;
  266.       end;
  267.       InvalidateRect(HWindow,nil,false);
  268.       SendMessage(HWindow,tb_buttonhit,0,0);
  269.    end;
  270. end;
  271.  
  272. end.
  273.  
  274.